/* rcauis01.p  - Shipper auto create - main processing program                */
/* Copyright 1986-2002 QAD Inc., Carpinteria, CA, USA.                        */
/* All rights reserved worldwide.  This is an unpublished work.               */
/* $Revision: 1.17 $                                                          */
/*V8:ConvertMode=NoConvert                                                    */
/* REVISION: 9.1            CREATED: 04/01/00   BY: *N0B5* Vinay Nayak-Sujir  */
/* REVISION: 9.1      LAST MODIFIED: 08/12/00   BY: *N0KP* Mark Brown         */
/* Revision: 1.3      BY: Katie Hilbert       DATE: 04/01/01   ECO: *P002*    */
/* Revision: 1.4      BY: Rajaneesh Sarangi   DATE: 06/29/01   ECO: *M1CP*    */
/* Revision: 1.6      BY: Dan Herman          DATE: 02/06/02   ECO: *P00G*    */
/* Revision: 1.8      BY: Amit Chaturvedi     DATE: 04/23/02   ECO: *N1H3*    */
/* Revision: 1.9      BY: Jean Miller         DATE: 05/23/02   ECO: *P074*    */
/* Revision: 1.10     BY: Sandeep Parab       DATE: 06/04/02   ECO: *M1XH*    */
/* Revision: 1.11     BY: Sandeep Parab       DATE: 06/20/02   ECO: *P09G*    */
/* Revision: 1.12     BY: Robin McCarthy      DATE: 07/02/02   ECO: *P0B2*    */
/* Revision: 1.13     BY: Samir Bavkar        DATE: 07/07/02   ECO: *P0B0*    */
/* Revision: 1.14     BY: Robin McCarthy      DATE: 07/15/02   ECO: *P0BJ*    */
/* Revision: 1.15     BY: Samir Bavkar        DATE: 08/15/02   ECO: *P09K*    */
/* Revision: 1.16     BY: Samir Bavkar        DATE: 08/18/02   ECO: *P0FS*    */
/* $Revision: 1.17 $  BY: Manjusha Inglay     DATE: 08/27/02   ECO: *N1S3*    */

/******************************************************************************/
/* All patch markers and commented out code have been removed from the source */
/* code below. For all future modifications to this file, any code which is   */
/* no longer required should be deleted and no in-line patch markers should   */
/* be added.  The ECO marker should only be included in the Revision History. */
/******************************************************************************/

/* The program contains most of the processing done in rcsois1.p
 * Some code has been cloned and the remainder restructured for
 * better flow and readability. Because it relies on old existing
 * programs to do the processing, this program has to depend on
 * shared variables.
 */

{mfdeclre.i}
{gplabel.i}
{gldydef.i new}
{gldynrm.i new}

define input parameter  shipfrom   like abs_shipfrom no-undo.
define input parameter  absid      like abs_id no-undo.
define input parameter  ship_date  as date no-undo.
define input parameter  effective_date   as date no-undo.
define input parameter  post_inv like mfc_logical no-undo.
define input parameter  shipnum_as_inv like mfc_logical no-undo.
define input parameter  consol_inv like mfc_logical no-undo.
define input parameter  err_file      as character  no-undo.
define input parameter  junk_file     as character  no-undo.
define output parameter shipper_processed_ok like mfc_logical no-undo.

define new shared variable rndmthd like rnd_rnd_mthd.
define new shared variable abs_carr_ref as character.
define new shared variable abs_fob like so_fob.
define new shared variable abs_recid as recid.
define new shared variable abs_shipvia like so_shipvia.
define new shared variable accum_wip like tr_gl_amt.
define new shared variable already_posted like glt_amt.
define new shared variable auto_post like mfc_logical.
define new shared variable base_amt like ar_amt.
define new shared variable batch like ar_batch.
define new shared variable batch_tot like glt_amt.
define new shared variable bill like so_bill.
define new shared variable bill1 like so_bill.
define new shared variable change_db like mfc_logical.
define new shared variable consolidate like mfc_logical.
define new shared variable cr_acct like trgl_cr_acct.
define new shared variable cr_amt as decimal format "->>>,>>>,>>>.99".
define new shared variable cr_cc like trgl_cr_cc.
define new shared variable cr_proj like trgl_cr_proj.
define new shared variable cr_sub  like trgl_cr_sub.
define new shared variable curr_amt like glt_amt.
define new shared variable cust like so_cust.
define new shared variable cust1 like so_cust.
define new shared variable desc1 like pt_desc1 format "x(49)".
define new shared variable dr_acct like trgl_dr_acct.
define new shared variable dr_amt as decimal format "->>>,>>>,>>>.99".
define new shared variable dr_cc like trgl_dr_cc.
define new shared variable dr_sub like trgl_dr_sub.
define new shared variable eff_date like glt_effdate.
define new shared variable exch_rate like exr_rate.
define new shared variable exch_rate2 like exr_rate2.
define new shared variable exch_ratetype like exr_ratetype.
define new shared variable exch_exru_seq like exru_seq.
define new shared variable ext_cost like sod_price.
define new shared variable ext_disc as decimal decimals 2.
define new shared variable gr_margin like sod_price
   format "->>>>,>>9.99".
define new shared variable ext_gr_margin like gr_margin.
define new shared variable base_margin like ext_gr_margin.
define new shared variable ext_list like sod_list_pr decimals 2.
define new shared variable ext_price as decimal
   decimals 2 format "->>>>,>>>,>>9.99".
define new shared variable base_price like ext_price.
define new shared variable freight_ok like mfc_logical.
define new shared variable gl_amt like sod_fr_chg.
define new shared variable gl_sum like mfc_logical initial yes.
define new shared variable inv like ar_nbr.
define new shared variable inv1 like ar_nbr label {t001.i}.
define new shared variable inv_only like mfc_logical initial yes.
define new shared variable loc like pt_loc.
define new shared variable lotserial_total like tr_qty_chg.
define new shared variable name like ad_name.
define new shared variable nbr like tr_nbr.
define new shared variable net_price like sod_price.
define new shared variable net_list like sod_list_pr.
define new shared variable old_ft_type as character.
define new shared variable ord-db-cmtype like cm_type no-undo.
define new shared variable order_ct as integer.
define new shared variable order_nbrs as character extent 30.
define new shared variable order_nbr_list as character no-undo.
define new shared variable part as character format "x(18)".
define new shared variable post like mfc_logical.
define new shared variable post_entity like ar_entity.
define new shared variable print_lotserials like mfc_logical.
define new shared variable project like wo_project.
define new shared variable que-doc as logical.
define new shared variable qty as decimal.
define new shared variable qty_all like sod_qty_all.
define new shared variable qty_pick like sod_qty_pick.
define new shared variable qty_bo like sod_bo_chg.
define new shared variable qty_chg like sod_qty_chg.
define new shared variable qty_cum_ship like sod_qty_ship.
define new shared variable qty_inv like sod_qty_inv.
define new shared variable qty_iss_rcv like tr_qty_loc.
define new shared variable qty_left like tr_qty_chg.
define new shared variable qty_open like sod_qty_ord.
define new shared variable qty_ord like sod_qty_ord.
define new shared variable qty_req like in_qty_req.
define new shared variable qty_ship like sod_qty_ship.
define new shared variable ref like glt_ref.
define new shared variable rejected like mfc_logical no-undo.
define new shared variable rmks like tr_rmks.
define new shared variable sct_recid as recid.
define new shared variable sct_recno as recid.
define new shared variable ship_db like global_db.
define new shared variable ship_dt like so_ship_date.
define new shared variable ship_line like sod_line.
define new shared variable ship_site as character.
define new shared variable ship_so like so_nbr.
define new shared variable should_be_posted like glt_amt.
define new shared variable so_db like global_db.
define new shared variable so_job like tr_so_job.
define new shared variable so_hist like soc_so_hist.
define new shared variable so_mstr_recid as recid.
define new shared variable so_recno as recid.
define new shared variable sod_entity like en_entity.
define new shared variable sod_recno as recid.
define new shared variable std_cost like sod_std_cost.
define new shared variable tax_recno as recid.
define new shared variable tot_curr_amt like glt_amt.
define new shared variable tot_ext_cost like sod_price.
define new shared variable tot_line_disc as decimal decimals 2.
define new shared variable tr_recno as recid.
define new shared variable transtype as character format "x(7)".
define new shared variable trgl_recno as recid.
define new shared variable trlot like tr_lot.
define new shared variable trqty like tr_qty_chg.
define new shared variable unit_cost like tr_price.
define new shared variable undo_all like mfc_logical no-undo.
define new shared variable use_shipper like mfc_logical.
define new shared variable wip_entity like si_entity.
define new shared workfile work_sr_wkfl like sr_wkfl.
define new shared variable yn like mfc_logical.
define new shared variable critical-part like wod_part no-undo.
define new shared variable prog_name as character initial "rcauis.p"
   no-undo.
define new shared variable confirm_mode like mfc_logical no-undo.
define new shared variable auto_inv     like mfc_logical.
define new shared variable l_undo       like mfc_logical no-undo.

define shared variable global_recid as recid.

define variable abs_trans_mode as character.
define variable abs_veh_ref as character.
define variable first_so_bill like so_bill.
define variable first_so_cust like so_cust.
define variable first_so_curr like so_curr.
define variable first_so_cr_terms like so_cr_terms.
define variable first_so_slspsn like so_slspsn.
define variable first_so_trl1_cd like so_trl1_cd.
define variable first_so_trl2_cd like so_trl2_cd.
define variable first_so_trl3_cd like so_trl3_cd.
define variable first_so_entity like si_entity no-undo.
define variable l_first_so_nbr like so_nbr no-undo.

define variable msg_text as character.
define variable shipqty as decimal no-undo.
define variable txcalcref as character.
define variable l_consolidate_ok like mfc_logical no-undo.
define variable oldcurr like so_curr.
define variable errorst like mfc_logical no-undo.
define variable errornum as integer no-undo.
define variable l_disc_pct1 as decimal no-undo.
define variable l_net_price as decimal no-undo.
define variable l_list_price as decimal no-undo.
define variable l_rec_no as recid no-undo.
define variable change-queued as logical no-undo.
define variable l_flag like mfc_logical no-undo.
define variable undo_stat like mfc_logical no-undo.
define variable validation_ok like mfc_logical no-undo.
define variable continue_process like mfc_logical no-undo.
define variable use-log-acctg         as logical no-undo.
define variable first_so_site         like  so_site      no-undo.
define variable first_so_ex_rate      like  so_ex_rate   no-undo.
define variable first_so_ex_rate2     like  so_ex_rate2  no-undo.
define variable first_so_exru_seq     like  so_exru_seq  no-undo.
define variable tot_freight_gl_amt    like sod_fr_chg. /* NOT NO-UNDO */

define new shared temp-table work_ldd no-undo
   field work_ldd_id like abs_id
   index work_ldd_id work_ldd_id .

define buffer abs_temp for abs_mstr.

{rcwabsdf.i new}
{etvar.i &new="new"}
{etdcrvar.i "new"}
{etrpvar.i &new="new"}
{etsotrla.i "new"}
{fsdeclr.i new}
{gpglefdf.i}
{txcalvar.i}

{apconsdf.i}   /* PRE-PROCESSOR CONSTANTS FOR LOGISTICS ACCOUNTING */

/* CONSIGNMENT VARIABLES */
{socnvars.i}

/* FREIGHT ACCRUAL TEMP TABLE DEFINITION */
{lafrttmp.i "new"}

pause 0 before-hide.

/* DETERMINE IF CUSTOMER CONSIGNMENT IS ACTIVE */
{gprun.i ""gpmfc01.p""
   "(input ENABLE_CUSTOMER_CONSIGNMENT,
     input 10,
     input ADG,
     input CUST_CONSIGN_CTRL_TABLE,
     output using_cust_consignment)"}

/* CHECK IF LOGISTICS ACCOUNTING IS ENABLED */
{gprun.i ""lactrl.p"" "(output use-log-acctg)"}

for first shc_ctrl no-lock:
end.

/* Set the values of the shared vars. Since this routine re-uses
   a lot of processing, the existing shared vars have to get correctly
   updated. Besides other initialization */
assign
   ship_dt = ship_date
   eff_date = effective_date
   auto_post = post_inv
   use_shipper = shipnum_as_inv
   consolidate = consol_inv
   confirm_mode = yes
   oldcurr = ""
   validation_ok = no
   shipper_processed_ok = no.

run del-qad-wkfl.

for each work_abs_mstr exclusive-lock:
   delete work_abs_mstr.
end.

for each work_ldd exclusive-lock:
   delete work_ldd.
end. /* FOR EACH work_ldd */

output to value (err_file).

mainblk:
do transaction:

   for first abs_mstr where
         abs_id = absid and
         abs_shipfrom = shipfrom
   no-lock: end.

   if not available abs_mstr then do:
      /* Shipper/Preshipper does not exist */
      run ip_msg (input 8147,input 3).
      undo mainblk, leave mainblk.
   end.

   abs_recid = recid(abs_mstr).

   /* Explode shipper to get order detail. This creates
      a copy of the shipper and its child records in work_abs_mstr */
   {gprun.i ""rcsoisa.p"" "(input abs_recid)"}

   /* ADD CONSIGNMENT DATA TO work_abs_mstr */
   if using_cust_consignment then do:
      {gprunmo.i &module = "ACN" &program = "rcsoisa2.p"}
   end.  /* if using_cust_consignment */

   /* Validate contents of the shipper */
   run ip_val_shipper_details
      (input abs_recid,
       output validation_ok).

   if validation_ok = false then
      undo mainblk, leave mainblk.

   if confirm_mode and substring(abs_status,1,1) <> "y" then
      /* Shipper not printed */
      run ip_msg (input 8147,input 2).

   assign
      abs_shipvia = substring(abs__qad01,1,20)
      abs_fob = substring(abs__qad01,21,20)
      abs_carr_ref = substring(abs__qad01,41,20)
      abs_trans_mode = substring(abs__qad01,61,20)
      abs_veh_ref = substring(abs__qad01,81,20).

   if abs_mstr.abs_id begins "p" then do:
      continue_process = no.
      run ip_gen_shipper_num
         (input abs_recid,
          output continue_process).
      if not continue_process then
         undo mainblk, leave mainblk.
   end.

   /* Check for unpegged shipper lines */
   {gprun.i ""rcsois4a.p""
      "(input abs_recid,
        output yn)"}
   if yn then undo mainblk, leave mainblk.

   /* Validates that there is adequate inventory available to ship all
      lines with same site, loc & part if over-issue not allowed */
   {gprun.i ""rcsoisg.p""}
   if rejected then undo mainblk, leave mainblk.

   assign
      tot_freight_gl_amt = 0
      order_ct = 0.

   for each work_abs_mstr no-lock ,
       each sod_det where sod_nbr = abs_order and
                          sod_line = integer(abs_line)
   exclusive-lock
   break by sod_nbr by sod_line:

      if first(sod_nbr) then
      for first so_mstr where so_nbr = sod_nbr
      exclusive-lock: end.

      if (oldcurr <> so_curr) or (oldcurr = "") then do:

         {gprunp.i "mcpl" "p" "mc-get-rnd-mthd"
            "(input so_curr,
              output rndmthd,
              output mc-error-number)"}

         if mc-error-number <> 0 then do:
            run ip_msg (input mc-error-number,input 3).
            undo mainblk, leave mainblk.
         end.

         oldcurr = so_curr.
      end.

      if first(sod_nbr) then do:

         assign
            l_first_so_nbr = so_nbr
            first_so_bill = so_bill
            first_so_cust = so_cust
            first_so_curr = so_curr
            first_so_cr_terms = so_cr_terms
            first_so_trl1_cd = so_trl1_cd
            first_so_trl2_cd = so_trl2_cd
            first_so_trl3_cd = so_trl3_cd
            first_so_slspsn[1] = so_slspsn[1]
            first_so_slspsn[2] = so_slspsn[2]
            first_so_slspsn[3] = so_slspsn[3]
            first_so_slspsn[4] = so_slspsn[4]
            first_so_site      = so_site
            first_so_ex_rate   = so_ex_rate
            first_so_ex_rate2  = so_ex_rate2
            first_so_exru_seq  = so_exru_seq.

         for first si_mstr where si_site = so_site
         no-lock: end.

         first_so_entity = if available si_mstr then
                              si_entity
                           else "".

         {gprun.i ""gpcust.p""
            "(input  so_nbr,
              output ord-db-cmtype)"}

      end. /* if first(sod_nbr)  */

      shipqty = (if confirm_mode then
      (work_abs_mstr.abs_qty - work_abs_mstr.abs_ship_qty)
      else
      (work_abs_mstr.abs_qty)) * decimal(work_abs_mstr.abs__qad03).

      if abs_item = sod_part then
         accumulate shipqty (sub-total by sod_line).

      if first-of(sod_nbr) then do:

         order_ct = order_ct + 1.

         if order_ct <= 30 then
            order_nbrs[order_ct] = sod_nbr.
         else
            order_nbr_list = order_nbr_list + sod_nbr + ",".

         if use_shipper then do:

            if can-find(first so_mstr where
               so_inv_nbr = substring (abs_mstr.abs_id,2,50))
               or can-find(ar_mstr where
               ar_nbr = substring (abs_mstr.abs_id,2,50))
               or can-find(first ih_hist where
               ih_inv_nbr = substring (abs_mstr.abs_id,2,50))
            then do:
               /* Shipper # already used by invoice/order, cannot
               auto invoice */
               run ip_msg (input 8150,input 3).
               undo mainblk, leave mainblk.
            end.

         end. /* if use_shipper  */

         if consolidate then do:
            msg_text = "".

            {gprun.i ""soconso.p""
               "(input 2,
                 input  l_first_so_nbr ,
                 input  so_nbr ,
                 output l_consolidate_ok,
                 output msg_text)"}

            if msg_text > "" then do:
               /* Mismatch with pending invoice - cannot consolidate */
               {pxmsg.i &MSGNUM=1046 &ERRORLEVEL=3 &MSGARG1=msg_text}
               undo mainblk, leave mainblk.
            end.

         end. /* if consolidate  */


         if use-log-acctg then do:

            msg_text = "".

            run validateSOForLogisticsAccounting
                   (input l_first_so_nbr,
                    input so_nbr,
                    output msg_text).

            if msg_text > "" then do:
               /* ALL ATTACHED ORDERS MUST HAVE SAME # */
               {pxmsg.i &MSGNUM=5588 &ERRORLEVEL=3 &MSGARG1=msg_text}
               undo mainblk, leave mainblk.
            end.

         end. /* IF USE-LOG-ACCTG */

         if so_fix_rate then
            assign
               exch_rate = so_ex_rate
               exch_rate2 = so_ex_rate2
               exch_ratetype = so_ex_ratetype
               exch_exru_seq = so_exru_seq.

         else do:
            {gprunp.i "mcpl" "p" "mc-get-ex-rate"
               "(input  so_curr,
                 input  base_curr,
                 input  so_ex_ratetype,
                 input  eff_date,
                 output exch_rate,
                 output exch_rate2,
                 output mc-error-number)" }

            if mc-error-number <> 0 then do:
               run ip_msg (input mc-error-number,input 3).
               undo mainblk, leave mainblk.
            end.

            assign
               exch_ratetype = so_ex_ratetype
               exch_exru_seq = 0.
         end. /* else  (if so_fix_rate) */

         for first so_mstr where so_nbr = sod_nbr
         exclusive-lock: end.

         assign
            so_to_inv = yes
            so_ship_date = ship_dt
            so_invoiced = no
            so_tax_date = ship_dt.

      end. /* if first-of(sod_nbr)  */

      if last-of(sod_line) then do:

         if change_db then do:
            run ip_alias (input ship_db,output l_flag).
            if l_flag then undo mainblk, leave mainblk.
         end.

         {gprun.i ""gpsct05.p""
            "(input sod_part,
              input sod_site,
              input 1,
              output glxcst,
              output curcst)"}

         if change_db then do:
            run ip_alias (input so_db,output l_flag).
            if l_flag then undo mainblk, leave mainblk.
         end.

         sod_std_cost = glxcst * sod_um_conv.

         if sod_sched then do:

            if sod_cum_qty[3] > 0 and
               sod_cum_qty[1] +
               ((accum sub-total by sod_line shipqty) / sod_um_conv)
               >= sod_cum_qty[3]
            then do:
               /* Cum shipped qty >= max order qty for order selected*/
               {pxmsg.i &MSGNUM=8310 &ERRORLEVEL=1
                        &MSGARG1=sod_nbr
                        &MSGARG2=sod_line}
               run ip_msg (input 8220,input 2).
            end.

            for first pt_mstr where pt_part = sod_part
            no-lock: end.

            for first soc_ctrl no-lock: end.

            assign
               l_disc_pct1 = 0
               l_net_price = ?
               l_rec_no = ?
               l_list_price = 0.

            if available pt_mstr then do:

               {gprunp.i "mcpl" "p" "mc-curr-conv"
                  "(input  base_curr,
                    input  so_curr,
                    input  exch_rate2,
                    input  exch_rate,
                    input  pt_price * sod_um_conv,
                    input  false,
                    output l_list_price,
                    output mc-error-number)"}.

               if mc-error-number <> 0 then do:
                  run ip_msg (input mc-error-number,input 3).
                  undo mainblk, leave mainblk.
               end.

            end. /* if available pt_mstr  */

            {gprun.i ""gppccal.p""
              "(input  sod_part,
                input (accum sub-total by sod_line shipqty) / sod_um_conv,
                input sod_um,
                input sod_um_conv,
                input so_curr,
                input sod_pr_list ,
                input eff_date,
                input sod_std_cost,
                input soc_pl_req,
                0.0,
                input-output  l_list_price,
                output        l_disc_pct1,
                input-output  l_net_price,
                output        l_rec_no)"}

            if l_net_price <> ? then sod_price = l_net_price.

            if pt_price = 0 then
               sod_list_pr = sod_price.

         end. /* if sod_sched  */

         sod_qty_chg = (accum sub-total by sod_line shipqty) / sod_um_conv.

      end. /* if last-of(sod_line)  */

      if last-of(sod_nbr) then do:

         gl_amt = 0.

         if so_fr_terms <> "" then do:

            for first ft_mstr where ft_terms = so_fr_terms
            no-lock: end.

            if available ft_mstr then old_ft_type = ft_type.
            so_mstr_recid = recid(so_mstr).

            output close.
            output to value(junk_file).

            {gprun.i ""sofrcals.p""}

            output close.
            output to value (err_file) append.

            if not freight_ok then
               /* Freight error detected */
               run ip_msg (input 669,input 2).

         end. /* if so_fr_terms <> ""  */

         /* Manual update of trailer data is normally done at this
            point but because this program processes in batch, the
            invocation to rcsoistr.p has been excluded */


         /* WHEN POSTING FREIGHT WITH LOGISTICS ACCOUNTING WE NEED THE    */
         /* TRANSACTION NUMBER(tr_trnbr)FOR THE "ISS-SO" TRANSACTION.     */
         /* THIS NUMBER IS USED TO RELATE THE TRGL_DET RECORDS CREATED IN */
         /* LAFRPST.P TO "ISS-SO" TRANSACTION(TR_HIST) RECORD.            */
         /* THERFORE THE FREIGHT ACCRUAL POSTING FOR LOGISTICS ACCOUNTING */
         /* IS DONE AFTER SHIPMENTS ARE PROCESSED (I.E. AFTER RCSOIS1A.P  */
         /* IS CALLED).                                                   */

         /* POST FREIGHT ACCRUALS */
         if gl_amt <> 0 and (not use-log-acctg) then do:
            so_mstr_recid = recid(so_mstr).
            {gprun.i ""sofrpst.p"" "(input eff_date)"}
         end. /* IF GL_AMT <> 0 */

         tot_freight_gl_amt = tot_freight_gl_amt + gl_amt.


      end. /* if last-of(sod_nbr)  */

   end. /* for each work_abs_mstr  */

   txcalcref = string(abs_mstr.abs_shipfrom,"x(8)") + abs_mstr.abs_id.

   {gprun.i ""txcalc.p""
      "(input ""14"",
        input txcalcref,
        input '*',
        input 0     ,
        input no ,
        output result-status)"}

   for each work_abs_mstr no-lock ,
       each sod_det exclusive-lock where
            sod_nbr = abs_order and
            sod_line = integer(abs_line) ,
       each so_mstr exclusive-lock where
            so_nbr = sod_nbr
   break by sod_nbr by sod_line:

      if last-of(sod_nbr) then do:

         {gprun.i ""txdelete.p""
            "(input '13',
              input sod_nbr,
              input '' )"}

         {gprun.i ""txdetcpy.p""
            "(input txcalcref,
              input sod_nbr,
              input '14',
              input sod_nbr,
              input '',
              input '13')"}

      end. /* if last-of(sod_nbr) */

   end. /* for each work_abs_mstr */

   /* Generate lot # from a sequence */
   run ip_gen_trlot
      (output continue_process).
   if not continue_process then
      undo mainblk, leave mainblk.

   /* The real core of the processing is here. Inside this
      procedure, inventory is relieved, accounts affected, etc*/
   /* Added input using_cust_consignment    */
   {gprun.i ""rcsois1a.p""
      "(input ""so_shipper_confirm"",
        input using_cust_consignment,
        output undo_stat)" }

   if l_undo
   then do:
      if not batchrun
      then
         pause.
      undo mainblk, leave mainblk.
   end. /* IF l_undo */

   if undo_stat then
      undo mainblk, leave mainblk.


      /* FREIGHT POSTING WITH LOGISTICS ACCOUNTING DISABLED ARE HANDLED */
      /* ABOVE BY SOFRPST.P                                             */

      /* POST FREIGHT ACCRUALS WITH LOGISTICS ACCOUNTING ENABLED    */
      if use-log-acctg and tot_freight_gl_amt <> 0 then do:

         /* IF LOGISTICS ACCOUNTING IS ENABLED THEN CREATE PENDING VOUCHER */
         /* MASTER AND DETAIL RECORDS AND POST THE FREIGHT TO THE GL.      */


         {gprunmo.i &module  = "LA" &program = "lafrpst.p"
                    &param   = """(input '{&TYPE_SOShipper}',
                                   input substring(abs_mstr.abs_id,2),
                                   input substring(abs__qad01,41,20), /*EXT-RF*/
                                   input abs_mstr.abs_shp_date,
                                   input eff_date,
                                   input abs_mstr.abs_shipto,   /* SHIP-TO */
                                   input '{&TYPE_SO}',
                                   input first_so_curr,
                                   input first_so_ex_rate,
                                   input first_so_ex_rate2,
                                   input ' ',  /* BLANK PVO_EX_RATETYPE */
                                   input first_so_exru_seq)"""}

      end. /* IF USE-LOG-ACCTG AND ... */

   global_recid = abs_recid.
   release sod_det.

   /* If the control reaches here, this shipper should have
      passed all validation and processing routines
      correctly. So this shipper is processed okay */
   shipper_processed_ok = yes.

end. /* mainblk */

output close.
pause before-hide.

{gpnbrgen.i}
{gpnrseq.i}

run del-qad-wkfl.

PROCEDURE p-shipreq-update:
/*-----------------------------------------------------------------
 PURPOSE   : Transfers the pegged ship line quantity from pre-shipper
             to newly created shipper
 PARAMETERS:
    Shipfrom - shipfrom site of shipper
    absid    - Preshipper ID
    shipnbr  - Newly created shipper ID
 NOTES:
-----------------------------------------------------------------*/
   define input parameter shipfrom like abs_shipfrom no-undo.
   define input parameter absid like abs_id no-undo.
   define input parameter shipnbr like abs_id no-undo.

   define buffer absr_det for absr_det.

   for each absr_det where absr_shipfrom = shipfrom and
                           absr_ship_id = absid
   exclusive-lock:
      assign
         absr_id = right-trim(substring (absr_id,1,1)) +
                   shipnbr +
                   right-trim(substring(absr_id,length (abs_mstr.abs_id) + 2))
         absr_ship_id = shipnbr.
   end.

END PROCEDURE.  /* p-shipreq-update */

PROCEDURE del-qad-wkfl:
/*-----------------------------------------------------------------
 PURPOSE   : Delete "semaphore" information maintained in qad_wkfl
             to indicate processing of sales order on the shipper.
 PARAMETERS:  <none>
 NOTES:
-----------------------------------------------------------------*/

   define buffer qad_wkfl for qad_wkfl.

   for each qad_wkfl where
            qad_key3 = "rcsois.p" and
            qad_key4 = mfguser
   exclusive-lock:
      delete qad_wkfl.
   end.

END PROCEDURE. /* del-qad-wkfl */

PROCEDURE p_glcalval:
/*-----------------------------------------------------------------
 PURPOSE   : Verifies open GL period for site/entity of each line item
 PARAMETERS:
    output l_flag - error condition, if "true"
 NOTES:
-----------------------------------------------------------------*/
   define output parameter l_flag like mfc_logical no-undo.

   define buffer work_abs_mstr for work_abs_mstr.
   define buffer si_mstr       for si_mstr.

   for each work_abs_mstr where
      work_abs_mstr.abs_qty <> work_abs_mstr.abs_ship_qty and
      (work_abs_mstr.abs_id begins "i" or
       work_abs_mstr.abs_id begins "c")
   no-lock:

      for first si_mstr
         fields (si_db si_desc si_entity si_site)
         where si_site = work_abs_mstr.abs_site
      no-lock: end.

      /* Check GL effective date */
      if available si_mstr then do:

         {gpglef01.i ""IC"" si_entity eff_date}

         if gpglef > 0 then do:
            {pxmsg.i &MSGNUM=gpglef &ERRORLEVEL=4 &MSGARG1=si_entity}
            l_flag = yes.
            return.
         end.

         else do:
            {gpglef01.i ""SO"" si_entity eff_date}

            if gpglef > 0 then do:
               {pxmsg.i &MSGNUM=gpglef &ERRORLEVEL=4 &MSGARG1=si_entity}
               l_flag = yes.
               return.
            end.

         end.

      end. /* if available si_mstr */

   end. /* for each work_abs_mstr */

END PROCEDURE. /* p_glcalval */

PROCEDURE ip_msg:
/*-----------------------------------------------------------------
 PURPOSE   : Message processing routine
 PARAMETERS:
    input l_num - error #
    input l_stat - severity of error, 1-info, 2-warn, 3&4-error
 NOTES:
-----------------------------------------------------------------*/
   define input parameter i_num as integer no-undo.
   define input parameter i_stat as integer no-undo.

   {pxmsg.i &MSGNUM=i_num &ERRORLEVEL=i_stat}

   if i_stat = 3 or i_stat = 4 then
      shipper_processed_ok = no.

END PROCEDURE. /* ip_msg */

PROCEDURE ip_alias:
/*-----------------------------------------------------------------
 PURPOSE   : Message processing routine
 PARAMETERS:
    input i_db - database name
    input o_err_flag - error flag
 NOTES:
-----------------------------------------------------------------*/
   define input parameter i_db like global_db no-undo.
   define output parameter o_err_flag like mfc_logical no-undo.

   define variable v_err_num as integer no-undo.

   {gprun.i ""gpalias3.p"" "(i_db, output v_err_num)" }
   o_err_flag = v_err_num = 2 or v_err_num = 3.

   if o_err_flag then do:
      /* Database not available */
      {pxmsg.i &MSGNUM=2510 &ERRORLEVEL=4 &MSGARG1=i_db}
   end.

END PROCEDURE. /* ip_alias */

PROCEDURE ip_val_shipper_details:
/*-----------------------------------------------------------------
 PURPOSE : Does a variety of validations including:
           Sales order exists
           Sales order not on hold
           For EMT order, no change is pending against the order
           Check if shipment against any sales order on this shipper
           is being confirmed in a parallel process. If not, use a
           semaphore mechanism to prevent anyone from grabbing the
           sales order.
 PARAMETERS:
    output validation_ok - Flag is false for
                           "Fatal failure, discontinue processing"
 NOTES:
-----------------------------------------------------------------*/
   define input parameter abs_recid as recid no-undo.
   define output parameter validation_ok like mfc_logical no-undo.

   define buffer b_abs_mstr    for abs_mstr.
   define buffer work_abs_mstr for work_abs_mstr.
   define buffer qad_wkfl      for qad_wkfl.
   define buffer sod_det       for sod_det.
   define buffer cmf_mstr      for cmf_mstr.
   define buffer cmd_det       for cmd_det.
   define buffer cm_mstr       for cm_mstr.
   define buffer df_mstr       for df_mstr.

   /* Valid has failed unless the entire procedure is successfully complete */
   validation_ok = false.

   procblk:
   do:
      /* Use the qad_wkfl to keep track of the sales orders being    */
      /* confirmed so that shippers related to the same order are not*/
      /* simultaneously confirmed.                                   */
      do transaction:

         for each work_abs_mstr no-lock where
               work_abs_mstr.abs_order <> "":

            for first qad_wkfl where
                  qad_key1 = "rcsois.p" and
                  qad_key2 = work_abs_mstr.abs_order
            no-lock: end.

            if available qad_wkfl
            and qad_wkfl.qad_key4 <> mfguser
            then do:
               /* SALES ORDER # IS BEING CONFIRMED BY USER # */
               {pxmsg.i &MSGNUM=2262 &ERRORLEVEL=3
                        &MSGARG1=qad_key2
                        &MSGARG2=qad_charfld[1]}
               leave procblk.
            end.

            else if not available qad_wkfl then do:
               create qad_wkfl.
               assign
                  qad_key1 = "rcsois.p"
                  qad_key2 = work_abs_mstr.abs_order
                  qad_key3 = "rcsois.p"
                  qad_key4 = mfguser
                  qad_charfld[1] = global_userid
                  qad_charfld[2] = work_abs_mstr.abs_par_id
                  qad_charfld[3] = work_abs_mstr.abs_shipfrom
                  qad_date[1] = today
                  qad_charfld[5] = string(time,"hh:mm:ss").

               if recid(qad_wkfl) = -1 then.
            end.

         end.

      end. /* do transaction */

      for each work_abs_mstr exclusive-lock:
         work_abs_mstr.abs_ship_qty = 0.
      end.

      que-doc = no.

      /*Exit if there is any pending change for btb order */
      for each work_abs_mstr no-lock
            break by work_abs_mstr.abs_order:

         if first-of (work_abs_mstr.abs_order) and
            work_abs_mstr.abs_order <> ""
         then do:

            for first so_mstr where so_nbr = abs_order
            no-lock: end.

            for first sod_det where sod_nbr = abs_order and
                  sod_line = integer(abs_line)
            no-lock: end.

            if available so_mstr and available sod_det
            then do:

               if not so_secondary then
               for first cmf_mstr where cmf_doc_type = "PO" and
                                        cmf_doc_ref = sod_btb_po and
                  (cmf_status = "1" or cmf_status = "2" or
                   cmf_status = "3")
               no-lock: end.

               else do:

                  for first cmf_mstr where cmf_doc_type = "SO" and
                        cmf_doc_ref = so_nbr and
                        cmf_status = "1"
                  no-lock: end.

                  if available cmf_mstr then
                  for first cmd_det where
                      cmd_trans_nbr = cmf_trans_nbr and
                      cmd_key_val = so_nbr + "," + string(sod_line) and
                     (cmd_field = "sod_due_date" or cmd_field = "sod_qty_ord")
                  no-lock: end.

                  if available cmd_det then change-queued = yes.

               end.

            end. /* if available so_mstr and available sod_det */

            if (not so_secondary and available cmf_mstr) or
               (so_secondary and change-queued)
            then do:
               /* CHANGE ON BTB SO WITH PENDING CHANGE IS NOT ALLOWED */
               run ip_msg (input 2834,input 3).
               leave procblk.
            end. /* if (not so_secondary and avail cmf_mstr) */

            if available so_mstr and
               so_secondary and
               not que-doc
            then
               que-doc = yes.
         end. /* if first-of (work_abs_mstr.abs_order) */

      end. /* for each work_abs_mstr */

      run p_glcalval (output l_flag).
      if l_flag then
         leave procblk.

      /* Warn if there is any sales orders on the shipper that has
      its action status non-blank */
      for each work_abs_mstr no-lock where
            abs_order <> "" and
            abs_line <> ""
      break by abs_shipfrom by abs_order:

         if first-of (abs_order) then do:

            for first so_mstr where so_nbr = abs_order
            no-lock: end.

            if available so_mstr then do:

               for first cm_mstr where cm_addr = so_bill
               no-lock: end.

               if available cm_mstr
               and cm_mstr.cm_cr_hold
               then
                  /* CUSTOMER ON CREDIT HOLD */
                  run ip_msg (input 614,input 2).

               if so_stat <> "" then
                  /* SALES ORDER STATUS NOT BLANK */
                  run ip_msg (input 623,input 2).

            end. /* if available so_mstr */
            else do:
               /* SALES ORDER DOES NOT EXIST  */
               run ip_msg (input 609,input 3).
               leave procblk.
            end.

         end. /* if first-of (abs_order) */

         if not can-find(sod_det where
            sod_nbr = abs_order and
            sod_line = integer (abs_line) and
            sod_part = abs_item)
         then do:
            /* SALES ORDER LINE DOES NOT EXIST  */
            run ip_msg (input 764,input 3).
            leave procblk.
         end.

      end. /* for each work_abs_mstr */

      for first b_abs_mstr where recid(b_abs_mstr) = abs_recid no-lock:
         for first df_mstr where
                   df_format = abs_format and
                   df_type = "1"
         no-lock: end.
      end.

      if available df_mstr
      and df_mstr.df_inv /* if the shipper doc serves as invoice */
      and not use_shipper
      then
         /* Document format requires shipper number to be used for invoice */
         run ip_msg (input 5992,input 2).

      /* If the validation has passed all tests so far, it
         has passed this routine. So give it the "stamp of approval */
      validation_ok = true.

   end. /* procblk */

END PROCEDURE.  /* ip_val_shipper_details */

PROCEDURE ip_gen_shipper_num:
/*--------------------------------------------------------------------------
 PURPOSE : Generate a shipper number. Use this procedure when the
           original structure is a pre-shipper.
 PARAMETERS:
    input absrecid - recid of abs_mstr record
    output continue_process - logical tells whether to continue processing
NOTES:
---------------------------------------------------------------------------*/
   define input parameter absrecid as recid no-undo.
   define output parameter continue_process like mfc_logical no-undo.

   define variable shipnbr like abs_mstr.abs_id no-undo.
   define variable shipgrp like sg_grp no-undo.
   define variable nrseq like shc_ship_nr_id no-undo.
   define variable is_internal like mfc_logical no-undo.

   define buffer b_abs_mstr for abs_mstr.
   define buffer shc_ctrl   for shc_ctrl.
   define buffer sgid_det   for sgid_det.

   procblk:
   do for b_abs_mstr:

      continue_process = no.

      for first shc_ctrl
      no-lock: end.

      for first b_abs_mstr where recid(b_abs_mstr) = absrecid
      no-lock: end.

      {gprun.i ""gpgetgrp.p""
         "(input  abs_shipfrom,
           input  abs_shipto,
           output shipgrp)"}

      nrseq = shc_ctrl.shc_ship_nr_id.

      if shipgrp <> ? then do:

         for first sgid_det where
               sgid_grp = shipgrp and
               sgid_inv_mov = abs_inv_mov
         no-lock: end.

         if available sgid_det then
            nrseq = sgid_ship_nr_id.
      end.

      run chk_internal
         (input nrseq,
          output is_internal,
          output errorst,
          output errornum).

      if errorst then do:
         run ip_msg (input errornum,input 3).
         leave procblk.
      end.

      if is_internal then do:
         run getnbr
            (input nrseq,
             input today,
             output shipnbr,
             output errorst,
             output errornum).

         if errorst then do:
            run ip_msg (input errornum,input 3).
            leave procblk.
         end.

      end.

      else do:
         /* Auto Confirm needs internal sequence for pre-shipper */
         run ip_msg (input 8590,input 3).
         leave procblk.
      end.

      /* Since invoice # cannot be longer than 8 char. Error if
         shipper num is > 8 and "Use shipper # as Invoice # is yes */
      if use_shipper and
         length(shipnbr) > 8
      then do:
         /* Shipper # too long to use shipper document as invoice */
         run ip_msg (input 5982,input 3).
         leave procblk.
      end.

      shipnbr = "s" + shipnbr.

      run p-shipreq-update
         (input abs_shipfrom,
          input abs_id,
          input shipnbr).

      for first b_abs_mstr where recid(b_abs_mstr) = absrecid
      exclusive-lock: end.

      assign
         abs_preship_id = abs_id
         abs_preship_nr_id = abs_nr_id
         abs_nr_id = nrseq.

      /* Propogate number change thru abs_mstr */
      {gprun.i ""rcsoisa1.p""
         "(abs_shipfrom,
           abs_id,
           shipnbr)"}

      /* Propogate number change thru shipper structure */
      {gprun.i ""icshchg.p""
         "(absrecid, shipnbr)" }

      if right-trim(substring (abs_preship_id,2,20)) =
         right-trim(substring (abs__qad01,41,20)) then
      assign
         overlay(abs__qad01,41,20) = substring(abs_id,2,20)
         abs_carr_ref = substring(abs__qad01,41,20).

      if use-log-acctg then do:
         run changeShipperNumberInLogAcctDetail
                (input {&TYPE_SOPreShipper},
                 input substring(abs_mstr.abs_preship_id,2),
                 input abs_mstr.abs_shipfrom,
                 input {&TYPE_SOShipper},
                 input substring(abs_mstr.abs_id,2),
                 input abs_mstr.abs_shipfrom).
         end. /* IF USE-LOG-ACCTG */

      /* If the processing has got this far, everything went well */
      continue_process = yes.

   end. /* procblk */

END PROCEDURE.  /* ip_gen_shipper_num */

PROCEDURE ip_gen_trlot:
/*--------------------------------------------------------------------------
 PURPOSE : Generate a lot#
 PARAMETERS:
    output continue_process - logical tells whether to continue processing
 NOTES:
--------------------------------------------------------------------------*/
   define output parameter continue_process like mfc_logical no-undo.

   define variable err_flag like mfc_logical no-undo.

   continue_process = no.

   procblk:
   do:
      if change_db then do:
         run ip_alias (input ship_db,output err_flag).
         if err_flag then leave procblk.
      end.

      {gprun.i ""gpnxtsq.p"" "(output trlot)" }

      if change_db then do:
         run ip_alias (input so_db,output err_flag).
         if err_flag then leave procblk.
      end.

      continue_process = yes.

   end. /* procblk */

END PROCEDURE.  /* ip_gen_trlot */

/* INTERNAL PROCEDURES changeShipperNumberInLogAcctDetail AND          */
/*   validateSOForLogisticsAccounting ARE DEFINED IN larcsois.i        */
{rcsoisla.i}
